let id x = x

let string_length str =
  let s = ref 0 in
  let code = ref 0 in
  for i=0 to -1 + String.length str do
    code := int_of_char str.[i];
    if (!code land 128 <> 0 && !code land 64 <> 0)
      || (!code land 128 = 0) then (* caractère normal ou échappement utf 8 *)
      incr s;
  done ;
  !s

let changement_etat serv nom msg cause =
  try
    let open Tarotv in
    let etat =
      Serveur.dump serv nom in
    let () = Printf.printf "L'état côté serveur du joueur %s a changé : « %s ». Il a dit : %s.\n"
      nom cause msg in
    let prise = function
      | None -> "<rien>"
      | Some 0 -> "passe"
      | Some 1 -> "petite"
      | Some 2 -> "garde"
      | Some 3 -> "garde sans"
      | Some 4 -> "garde contre"
      | Some x -> ("<incompris : "^(string_of_int x)^">")
    in
    let string_of_joueur i =
      if i >= 0 && i < 5 then (string_of_int i)^" ("^(etat.mes_adversaires.(i))^")"
      else string_of_int i
    in
    let string_of_list string_of_element liste =
      "["^(String.concat "; " (List.map (string_of_element) liste))^"]"
    in
    let string_of_possession (poseur, carte, gagnant) =
      (Carte.string_of_carte carte)^" : "
      ^(string_of_joueur poseur)^" -> "^(string_of_joueur gagnant)
    in
    let string_of_jeu = string_of_list (Carte.string_of_carte) in
    let preneur = match etat.preneur with
      | None -> "<personne>"
      | Some i -> string_of_joueur i
    in
    let appel = match etat.joueur_appele, etat.carte_appelee with
      | (None, None) -> "<pas d'appel>"
      | (Some j, _) -> string_of_joueur j
      | (None, Some c) -> ("<le possesseur de "^(Carte.string_of_carte c)^">")
    in
    let ecart =
      " au moins "^(string_of_jeu etat.ecart_minimum)^", au plus "^(string_of_jeu etat.ecart_maximum)
    in
    let jeu = string_of_jeu etat.mon_jeu in
    let chien =
      match etat.chien with
      | [] -> "<pas encore dévoilé>"
      | chien -> string_of_jeu chien
    in
    let tapis = string_of_list (string_of_possession) etat.cartes_par_pli.(min 14 etat.nombre_plis_joues) in
    let maitre = 
      match etat.joueur_maitre with None -> "<personne>" | Some i -> string_of_joueur i
    in
    let pli_termine = if etat.pli_termine then "oui" else "non" in
    let pab = match etat.petit_au_bout with None -> "non"
      | Some `Defense -> "oui (pour la défense)"
      | Some `Attaque -> "oui (pour l'attaque)" in
    let plis_joues = string_of_int etat.nombre_plis_joues in
    let c_ouverture = match etat.couleur_demandee with
      | None -> "<aucune>"
      | Some c -> Carte.string_of_couleur c in
    let j_ouverture =  string_of_joueur etat.joueur_ouverture in
    let doit_priser = if etat.doit_priser then "oui" else "non" in
    let doit_appeler = if etat.doit_appeler then "oui" else "non" in
    let appelables = string_of_jeu etat.appelables in
    let doit_ecarter = if etat.doit_ecarter then "oui" else "non" in
    let doit_jouer = if etat.doit_jouer then "oui" else "non" in
    let jouables = string_of_jeu etat.jouables in
    let formulaire =
      [("est connecté", if etat.connecte then "oui" else "non") ;
       ("nom", etat.mon_nom) ;
       ("joueurs disponibles", 
	"["^(String.concat "; " etat.joueurs_disponibles)^"]") ;
       ("ses adversaires",
	"[|"^(String.concat "; " (Array.to_list etat.mes_adversaires))^"|]") ;
       ("est en train de jouer :", if etat.en_jeu then "oui" else "non") ;
       ("enchères formulées", 
	"[|"^(String.concat "; " (Array.to_list (Array.map (prise) etat.encheres)))^"|]") ;
       ("preneur", preneur) ;
       ("carte appelée", appel) ;
       ("partie connue de l'écart", ecart) ;
       ("mon jeu", jeu) ;
       ("chien", chien) ;
       ("cartes sur le tapis", tapis) ;
       ("joueur maître", maitre) ;
       ("le pli est terminé", pli_termine) ;
       ("nombre de plis joués", plis_joues) ;
       ("petit au bout", pab) ;
       ("couleur d'ouverture", c_ouverture) ;
       ("premier joueur de ce tour", j_ouverture) ;
       ("il doit priser", doit_priser) ;
       ("il doit faire un appel", doit_appeler) ;
       ("cartes appelables", appelables) ;
       ("il doit faire un écart", doit_ecarter) ;
       ("il doit jouer", doit_jouer) ;
       ("cartes jouables", jouables)] in
    let largeurs = List.map (fun (s1, s2) -> 1 + string_length s1 + string_length s2)
      formulaire in
    let largeur_max = match largeurs with
      | [] -> 0
      | a :: b -> List.fold_left (max) a b in
    let etendre (ch1, ch2) =
      let n1 = string_length ch1 in
      let n2 = string_length ch2 in
      let n_points = largeur_max - n1 - n2 in
      ch1^(String.make n_points '.')^ch2
    in
    let form_norme = List.map (etendre) formulaire in
    List.iter (print_endline) form_norme
  with
  | Not_found -> 
     Printf.printf "[impossible d'accéder à %s] : « %s ».\n"
       nom cause 

let table_sockets = Hashtbl.create 1
let table_rev = Hashtbl.create 1
let table_lecteurs = Hashtbl.create 1

let listeneur = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0
let () = Unix.bind listeneur (Unix.ADDR_INET (Unix.inet_addr_any, 45678))
let () = Unix.listen listeneur 3

let supprimer nom =
    try
      let client = Hashtbl.find table_sockets nom in
      let () = Unix.close client in
      let () = Hashtbl.remove table_sockets nom in
      let () = Hashtbl.remove table_rev client in
      Hashtbl.remove table_lecteurs client
    with _ -> ()

let s = Serveur.make ()

let a_flusher = Queue.create ()

let () = Serveur.set_suiveur s
  (fun nom etat -> changement_etat s nom etat)

let () = Serveur.set_envoyer s
  (fun nom msg -> 
    let client = Hashtbl.find table_sockets nom in
    let octets = Protocole.ecrire_message msg in
    try
      let sortie = Unix.out_channel_of_descr client in
      let () = Array.iter (output_byte sortie) octets in
      Queue.push sortie a_flusher 
    with
    | _ -> Serveur.enregistrer_deconnexion s nom)

let () = Serveur.set_deconnecter s (supprimer)
  
let work sec =
  let (pretes_a_lire, _, _) = Unix.select 
    (Hashtbl.fold (fun sock _ liste -> sock :: liste)
       table_lecteurs [listeneur]) [] [] sec in
  let messages_a_traiter = Queue.create () in
  let relever sock =
    let () = Printf.printf "Je traite une socket...\n" in
    if sock = listeneur then
      let () = Printf.printf "J'ajoute un anonyme...\n" in
      let (socket, _) = Unix.accept listeneur in
      let () = Unix.set_nonblock socket in
      let () = Hashtbl.add table_lecteurs socket (Protocole.lire_message ()) in
      let () = Printf.printf "Anonyme ajouté.\n" in
      ()
    else
      let lecteur = Hashtbl.find table_lecteurs sock in
      let chaine = "*" in
      let rec tout_lire ok =
	try
	  match Unix.read sock chaine 0 1 with
	  | 0 -> ok
	  | 1 -> 
	     let octet = (int_of_char chaine.[0]) in
	     let () = match lecteur octet with
	       | None -> ()
	       | Some msg -> 
		  Queue.push (sock, msg) messages_a_traiter
	     in
	     tout_lire true
	  | _ -> failwith "La fonction Unix.read a lu au moins 2 caractères alors que je lui en avais demandé 1"
	with
	| Unix.Unix_error (Unix.EAGAIN, _, _)
	| Unix.Unix_error (Unix.EWOULDBLOCK, _, _) -> 
	   ok
      in
      if not (tout_lire false) then
	(* Déconnecté *)
	let () = Printf.printf "On enregistre une déconnexion.\n" in
	try
	  let nom = Hashtbl.find table_rev sock in 
	  (* on ne continue que si c'est un gars identifié *)
	  let () = Serveur.enregistrer_deconnexion s nom in
	  supprimer nom
	with
	| Not_found -> ()
      else ()
  in
  let () = List.iter (relever) pretes_a_lire in
  let traiter (sock, msg) =
    let () = Printf.printf "Je traite un message...\n" in
    if Hashtbl.mem table_rev sock then
      let () = Printf.printf "Je traite le cas d'un client identifié...\n" in
      (* Message standard *)
      let nom = Hashtbl.find table_rev sock in
      try
	Serveur.assimiler_message s nom msg
      with
      | Not_found -> failwith ("Le client "^nom^" n'existe pas selon le serveur.")
    else (* Client anonyme *)
      let () = Printf.printf "Je traite le cas d'un client anonyme.\n" in
      let valider = function
	| None -> 
	   let () =
	     let () = Printf.printf "L'identification est refusée.\n" in
	     let octets = Protocole.ecrire_message Protocole.Refuse in
	     try
	       let sortie = Unix.out_channel_of_descr sock in
	       let () = Array.iter (output_byte sortie) octets in
	       flush sortie
	     with
	     | _ -> ()
	   in ()
	| Some nom ->
	   let () = Printf.printf "L'identification est validée.\n" in
	   let () =
	     (* On crée un joueur *)
	     let () = Hashtbl.add table_sockets nom sock in
	     let () = Hashtbl.add table_rev sock nom in
	     ()
	   in
	   ()
      in
      let () = Printf.printf "Message reçu du client anonyme.\n" in
      Serveur.nouveau_client s (fun _ -> true)
	(valider) msg 
  in
  let () = Queue.iter (traiter) messages_a_traiter in
  (* On flushe *)
  while not (Queue.is_empty a_flusher) do
    flush (Queue.take a_flusher)
  done

let () =
  while true do
    work 10.
  done
